
#|__________________________________________________________________________
 workmap3.lsp 
 constructor, defproto, slots, 
 Copyright (c) 1992-2002 by Forrest W. Young
 |#


(defun workmap ()
  (let* ((object (send workmap-proto :new 2 
                      :title "ViSta WorkMap"
                      :size '(475 280)
                      :show nil))
         )
    (send object :menu nil)
   ; (send object :has-v-scroll t) ;(- (send object :canvas-height) 50))
   ; (send object :has-h-scroll (- (send object :canvas-width) 50));t
    (send object :h-scroll-incs 25 100)
    (send object :v-scroll-incs 25 100)
    (send object :short-icon-titles t)
    (send object :range 0 0 30)
    (send object :range 1 0 10)
    (send object :margin 4 40 0 0)
          ;(- (send object :canvas-width) 104) 
          ;(- (send object :canvas-height) 65)
    object))



(defun desktop () (workmap))

(defproto workmap-proto
  '(num-data-icons      num-model-icons 
    data-icon-list      data-icon-number-list 
    model-icon-list     model-icon-number-list 
    selected-data-icon  previously-selected-data-icon
    num-data-menu-items num-model-menu-items  
    popped-out?         reanalysis?
    active-button-list  first-click-time 
    hot-icon            screen-saver-click-time)   
  nil iconmap-proto)

(defmeth workmap-proto :isnew (&rest args)
  (apply #'call-next-method args)
  (send self :num-data-icons 0)
  (send self :num-model-icons 0)
  (send self :first-click-time (/ (get-internal-real-time) 
                            internal-time-units-per-second))
  (send self :screen-saver-click-time (send self :first-click-time))
#+color (when (> *color-mode* 0) (send self :use-color t))
  )



(defmeth workmap-proto :pop-out-toggle ()
  (maximize-datasheet))



(defmeth workmap-proto :num-data-icons (&optional (val nil set))
  (if set (setf (slot-value 'num-data-icons) val))
  (slot-value 'num-data-icons))

(defmeth workmap-proto :num-model-icons (&optional (val nil set))
  (if set (setf (slot-value 'num-model-icons) val))
  (slot-value 'num-model-icons))

(defmeth workmap-proto :data-icon-list (&optional (val nil set))
  (if set (setf (slot-value 'data-icon-list) val))
  (slot-value 'data-icon-list))

(defmeth workmap-proto :model-icon-list (&optional (val nil set))
  (if set (setf (slot-value 'model-icon-list) val))
  (slot-value 'model-icon-list))

(defmeth workmap-proto :data-icon-number-list (&optional (val nil set))
  (if set (setf (slot-value 'data-icon-number-list) val))
  (slot-value 'data-icon-number-list))

(defmeth workmap-proto :model-icon-number-list (&optional (val nil set))
  (if set (setf (slot-value 'model-icon-number-list) val))
  (slot-value 'model-icon-number-list))

(defmeth workmap-proto :num-data-menu-items (&optional (val nil set))
  (if set (setf (slot-value 'num-data-menu-items) val))
  (slot-value 'num-data-menu-items))

(defmeth workmap-proto :num-model-menu-items (&optional (val nil set))
  (if set (setf (slot-value 'num-model-menu-items) val))
  (slot-value 'num-model-menu-items))

(defmeth workmap-proto :selected-data-icon (&optional (icon-number nil set))
  (if set (setf (slot-value 'selected-data-icon) icon-number))
  (slot-value 'selected-data-icon))

(defmeth workmap-proto :previously-selected-data-icon 
                        (&optional (icon-number nil set))
  (if set (setf (slot-value 'previously-selected-data-icon) icon-number))
  (slot-value 'previously-selected-data-icon))


(defmeth workmap-proto :hot-icon (&optional (icon-number nil set))
  (if set (setf (slot-value 'hot-icon) icon-number))
  (slot-value 'hot-icon))

(defmeth workmap-proto :first-click-time (&optional (number nil set))
"Message args: (&optional number)
 Sets or retrieves the time at which a click occurs to measure elapsed time for double-click." 
  (if set (setf (slot-value 'first-click-time) number))
  (slot-value 'first-click-time))

(defmeth workmap-proto :screen-saver-click-time (&optional (number nil set))
"Message args: (&optional number)
 Sets or retrieves the time at which a click occurs to measure elapsed time for the screen-saver." 
  (if set (setf (slot-value 'screen-saver-click-time) number))
  (slot-value 'screen-saver-click-time))

(defmeth workmap-proto :active-button-list (&optional (list nil set))
  (if set (setf (slot-value 'active-button-list) list))
  (slot-value 'active-button-list))

(defmeth workmap-proto :popped-out? (&optional (logical nil set))
  (if set (setf (slot-value 'popped-out?) logical))
  (slot-value 'popped-out?))

(defmeth workmap-proto :reanalysis? (&optional (logical nil set))
  (if set (setf (slot-value 'reanalysis?) logical))
  (slot-value 'reanalysis?))

(defmeth workmap-proto :data-in-construction (&optional args)
"Message args: (&optional args)
 Sets or retrieves if postpone redraw because a data object in construction. Currently this feature is turned off because it prevents redraw on errors."
  (send self :postpone-redraw args)
  nil)            
  
(defmeth workmap-proto :frame-poly (poly &optional (from-origin t))
  (if from-origin
      (call-next-method poly from-origin)
      (call-next-method (cumsum poly) t)))

(defun select-current-data-icon ()
  (send *workmap* :select-icon
        (select (send *workmap* :data-icon-number-list)
                (- current-item-number
                   (send *workmap* :num-data-menu-items)))))

(defmeth workmap-proto :gui (&optional (arg nil set))
  (when set 
        (setf (slot-value 'gui) arg)
        (cond 
          (arg
           (send self :show-window)
          ; (send self :redraw)
           )
          (t
           (send self :hide-window))))
  (slot-value 'gui))

(defmeth workmap-proto :toolbar (&optional (val nil set))
  (if set (setf (slot-value 'toolbar) val))
  (slot-value 'toolbar))

(defmeth workmap-proto :no-menu-marks (menu-object)
    (dolist (i (iseq 4 (- (length (send menu-object :items)) 1)))
             (send (select (send menu-object :items) i) :mark nil)))


(DEFMETH WORKMAP-PROTO :FREEZE-ALL-ICONS (NILT)
     (let ((icons (send self :icon-list)))
      	(when (not (send self :has-slot 'freeze))
             (send self :add-slot 'freeze)
             (defmeth workmap-proto :freeze (&optional (nilt nil set))
               (if set (setf (slot-value 'freeze) nilt))
               (slot-value 'freeze)))
       (send self :freeze nilt)
       (when icons
             (mapcar #'(lambda (icon) 
                         (send icon :freeze nilt))
                     icons))
       nilt))

(defmeth workmap-proto :no-icon-states-changing ()
  (let ((data-icons (send self :data-icon-list))
        (model-icons (send self :model-icon-list)))
    (when data-icons
          (mapcar #'(lambda (icon)
                      (send icon :icon-state-changing nil))
                  data-icons))
    (when model-icons
          (mapcar #'(lambda (icon)
                      (send icon :icon-state-changing nil))
                  model-icons))))


(defmeth workmap-proto :screen-saver ()
  (and *ENABLE-SCREEN-SAVER-FEATURE*
       (send *vista* :screen-saver-on)
       *screen-saver*))

(defmeth workmap-proto :screen-saver-showing ()
  (and *ENABLE-SCREEN-SAVER-FEATURE*
       (send *vista* :screen-saver-on)
       *screen-saver*
       (send *screen-saver* :showing)))

(defmeth workmap-proto :remove-screen-saver ()
  (when *screen-saver*
        (send *screen-saver* :idle-on nil)
        (send *screen-saver* :remove)
        (setf *screen-saver* nil))
  (send self :reset-screen-saver)
  )

(defmeth workmap-proto :hide-screen-saver ()
  (when *screen-saver*
        (send *screen-saver* :idle-on nil)
        (send *screen-saver* :hide-window))
  (send self :reset-screen-saver)
  )

(defmeth workmap-proto :stop-screen-saver ()
  (send self :idle-on nil)
  (when *datasheet* (send *datasheet* :idle-on nil))
  (when *screen-saver* 
        (send *screen-saver* :hide-window))
  )

(defmeth workmap-proto :reset-screen-saver ()
  (when (and *ENABLE-SCREEN-SAVER-FEATURE* 
             (send *vista* :screen-saver-on))
        (send self :screen-saver-click-time (/ (get-internal-real-time)
                                  internal-time-units-per-second))
        (defmeth workmap-proto :do-idle ()
          (let* ((max-idle-time (floor (* 60 (send *vista* :screen-saver-time))))
                 (current-time (/ (get-internal-real-time)
                                  internal-time-units-per-second))
                 (elapsed-time (- current-time (send self :screen-saver-click-time))))
            (when (> elapsed-time max-idle-time)
                  (defmeth workmap-proto :do-idle () )
                  (screen-saver)
                  )))
        (send self :idle-on t)))  
